ARIMA SERVICIOS SEMANALES

Introducción

Se determina el modelo de servicios diarios entre el períodode 2019 hasta julio de 2024 con frecuencia semanal.

ruta_servicios <- "/cloud/project/df_serv_dif.xlsx"
excel_sheets(ruta_servicios)

## [1] "Sheet1"

servicios <- as.data.frame(read_xlsx(ruta_servicios, 
                                     sheet = "Sheet1", col_names = T))

## New names:
## • `` -> `...1`

colnames(servicios) <- c("","Indice", "Fecha", "Totales")
servicios <- select(servicios, c("Indice", "Fecha", "Totales"))
servicios$ ...1 <- NULL
servicios$Semana <- format(x = servicios$Fecha, format = c("%Y-%U"))
nrow(servicios)

## [1] 183

Agrupando por semana.

servicios <- servicios %>%
  group_by(Fecha = as.character(Semana)) %>%
  summarize(Ventas_Totales = sum(Totales), 
            .groups = "keep")
head(servicios)

## # A tibble: 6 × 2
## # Groups:   Fecha [6]
##   Fecha   Ventas_Totales
##   <chr>            <dbl>
## 1 2019-26         -1.09 
## 2 2019-27         -2.42 
## 3 2019-28          2.06 
## 4 2019-29          0.444
## 5 2019-30          1.32 
## 6 2019-31         -2.56

Serie temporal

servicios_sem_ts <- ts(servicios$Ventas_Totales, start = 1, frequency = 1)
servicios_sem_xts <- as.xts(servicios_sem_ts, dateFormat = "POSIXct")

Visualizacion de la serie.

ts_plot(servicios_sem_ts, color = "darkgreen", Xtitle = "Fecha", 
        Ytitle = "Valores", 
        title = "Serie de servicios semanales")

plot.xts(x = servicios_sem_xts, bg = "white", 
              col = "black", labels.col = "black", 
         main = "Serie de servicios semanales")

Determinación de estacionalidad.

urca::ur.df(servicios_sem_ts)

## 
## ############################################################### 
## # Augmented Dickey-Fuller Test Unit Root / Cointegration Test # 
## ############################################################### 
## 
## The value of the test statistic is: -9.7867

El valor del estadístico de Dickey-Fuller es -9.7867. Este resultado, significativamente menor que el valor crítico, nos permite rechazar la hipótesis nula de que la serie tiene una raíz unitaria a un nivel de significancia del 5%. En consecuencia, se concluye que la serie de tiempo es estacionaria.

kpss.test(servicios_sem_ts)

## Warning in kpss.test(servicios_sem_ts): p-value greater than printed p-value

## 
##  KPSS Test for Level Stationarity
## 
## data:  servicios_sem_ts
## KPSS Level = 0.050977, Truncation lag parameter = 4, p-value = 0.1

KPSS Level = 0.050977, Truncation lag parameter = 4, p-value = 0.1 Ho:La serie de tiempo es estacionaria. Ha:La serie de tiempo no es estacionaria. Dado que el valor p es 0.1, mayor al nivel de significancia convencional de 0.05, no se rechaza la hipótesis nula.

Determinación de ACF y PACF.

ggAcf(servicios_sem_ts, col = "red", lwd = 1, lag.max = 52)

ggPacf(servicios_sem_ts, col = "blue", lag.max = 52, lwd = 1)

División de la serie en entrenamiento y prueba.

div_sem_serv <- ts_split(servicios_sem_ts, 
                                 sample.out =
                           round(length(servicios_sem_ts)*0.2))

entrena_serv_sem <- div_sem_serv$train

prueba_serv_sem <- div_sem_serv$test

Modelo

modelo_arima_sem_serv <- auto.arima(entrena_serv_sem, stationary = T, stepwise = F)
summary(modelo_arima_sem_serv)

## Series: entrena_serv_sem 
## ARIMA(1,0,4) with zero mean 
## 
## Coefficients:
##          ar1      ma1     ma2      ma3     ma4
##       0.5552  -0.9517  0.1917  -0.0482  0.2722
## s.e.  0.1741   0.1826  0.1603   0.1215  0.1086
## 
## sigma^2 = 8.076:  log likelihood = -256.57
## AIC=525.14   AICc=526   BIC=541.07
## 
## Training set error measures:
##                       ME     RMSE      MAE MPE MAPE     MASE        ACF1
## Training set 0.002082859 2.773311 2.154162 NaN  Inf 0.564156 0.001183363

# AIC=525.14   AICc=526   BIC=541.07
# ARIMA(1,0,4) with zero mean 

Residuales

checkresiduals(modelo_arima_sem_serv, col = "red") # p-value =  0.3805

## 
##  Ljung-Box test
## 
## data:  Residuals from ARIMA(1,0,4) with zero mean
## Q* = 5.2991, df = 5, p-value = 0.3805
## 
## Model df: 5.   Total lags used: 10

Pronóstico

pronostico_sem_serv <- forecast(modelo_arima_sem_serv, 
                                   h = length(prueba_serv_sem), 
                                   level = 0.95)

Gráficas de pronósticos

Evitando el cero absoluto

prueba_serv_sem <-  as.numeric(prueba_serv_sem)
prueba_serv_sem[prueba_serv_sem == 0] <- 1e-6

Medidas de exactitud.

accuracy(pronostico_sem_serv$mean, prueba_serv_sem)

##                   ME     RMSE      MAE      MPE     MAPE
## Test set 0.004388031 1.742557 1.275248 86608.24 86609.47

#                  ME    RMSE      MAE      MPE      MAPE       
# Test set 0.0043878 1.742557 1.275248 86608.24  86609.47       

Medidas de exactitud a 10 semanas.

accuracy(pronostico_sem_serv$mean[1:10], prueba_serv_sem[1:10])

##                 ME    RMSE       MAE      MPE     MAPE
## Test set 0.4320913 1.13248 0.9460443 222927.8 222930.9

#                 ME     RMSE      MAE      MPE      MAPE       
# Test set 0.4320912 1.13248 0.9460442 222927.8  222930.9       

Conclusiones

El modelo determinado está muy debajo del mejor, por lo cual no se considera un modelo óptimo.